# Knitr options
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, dev.args=list(bg="transparent"))
library(tidyverse)
library(magrittr)
library(showtext)
library(rgdal)
library(sf)
library(viridis)
library(plotly)
load("glptools_exports.RData")
source("helper_functions.R")
library(showtext)
showtext_auto()
font_add("Montserrat", "Montserrat/Montserrat-Regular.ttf")
font_add("Montserrat Bold", "Montserrat/Montserrat-SemiBold.ttf")
jfco_shp <- readOGR("JC Tracts", layer = "JC Tracts",
GDAL1_integer64_policy = TRUE, verbose = FALSE)
jfco_sf <- st_as_sf(jfco_shp) %>%
mutate(GEOID = str_sub(GEO_ID, start = -11))
There is no one universally-accepted definition of wealth within the Black community and, therefore, no direct data on Black Wealth in Louisville. This report assesses national data on wealth and local data on business ownership, housing finance, and income to give the most complete information currently available.
Wealth data remains scarce in general because the subject of wealth can be sensitive and is not taxed in a comprehensive way. Multiple surveys ask about income, and tax records show yearly income, but this data provides an incomplete picture, missing key metrics such as property ownership, community investment, inherited wealth, etc. As such, our measures of wealth remain indirect.
The national Survey of Consumer Finances (SCF), which occurs every three years, is our best source of wealth data. It measures “all assets over which a family has legal claim that can be used to finance its present and future consumption”. The most recently available data is from 2019, leaving the impact of the ongoing pandemic undefined. The key findings from the Federal Reserve report include:
Entrepreneurship is a key driver of wealth creation. Business owners are able to build wealth through their companies, and money spent at locally-owned business contributes to local wages and neighborhood development.
We have some data on business ownership from the Census Bureau’s Annual Business Survey. Detailed data by race is only available for “employer businesses” that have at least one employee. Businesses without employees make up 80% of registered businesses in Louisville, but they only comprise 1.8% of local business revenue.
[Include data on non-employer businesses by race at the MSA level with accompanying data.]
In Jefferson County, Black residents make up 21.9% of the population but only own 2.3% of employer-businesses. The graph below compares this ratio across Louisville’s cities. Cities would fall on the solid line if Black residents were represented equally among business owners and the population. The dotted line shows the average level of representation of Black residents among business owners in Louisville’s peer cities. Black residents are have higher-than-average representation in cities that fall above the dotted line, and they have below-average representation in cities below the line, but no cities, including Louisville, come close to equal representation.
pct_nonemp_business <- 57630 / (57630 + 14785)
pct_nonemp_revenue <- 2757359000 / (2757359000 + 152432057000)
business_ownership_county_clean <- business_ownership_county %>%
group_by(FIPS, year) %>%
mutate(
firm_percent = firms_num / firms_num[sex=="total" & race == "total"] * 100,
revenue_percent = revenue_num / revenue_num[sex=="total" & race == "total"] * 100) %>%
ungroup() %>%
filter(race == "black") %>%
pull_peers(add_info = T, FIPS_df = FIPS_df) %>%
filter(current == 1)
business_ownership_county_summary <- business_ownership_county_clean %>%
filter(FIPS != "21111") %>%
summarize(avg_ratio = mean(firm_percent / pop_percent)) %>%
pull(avg_ratio)
business_ownership_county_clean %<>%
mutate(marker_color = if_else(city == "Louisville", '#d63631', "#000000"))
lou <- filter(business_ownership_county_clean, city == "Louisville")
a <- list(
x = lou$pop_percent,
y = lou$firm_percent,
text = lou$city,
xref = "x",
yref = "y",
showarrow = F,
arrowhead = 0,
ax = 0,
ay = 10,
yanchor = "top")
b <- list(
x = 12,
y = 11,
text = "Equal representation",
xref = "x",
yref = "y",
showarrow = F,
arrowhead = 0,
ax = 0,
ay = 30,
xanchor = "left")
c <- list(
x = 40,
y = 7,
text = "Average representation in peer cities",
xref = "x",
yref = "y",
showarrow = F,
arrowhead = 0,
ax = 0,
ay = -16,
textangle = -20)
plot_ly(business_ownership_county_clean) %>%
add_markers(x = ~`pop_percent`, y = ~`firm_percent`,
text = business_ownership_county_clean$city,
color = ~I(marker_color),
marker = list(size = 10),
hoverinfo = 'text',
showlegend = FALSE) %>%
add_segments(x = 0, xend = 60,
y = 0, yend = 60,
name = "Equality",
line = list(color = '#323844', width = 1),
showlegend = FALSE) %>%
add_segments(x = 0, xend = 60,
y = 0, yend = business_ownership_county_summary * 60,
name = "Peer Average",
line = list(color = '#323844', width = 1, dash = 'dash'),
showlegend = FALSE) %>%
layout(
font = list(family = "Montserrat"),
annotations = list(a, b, c),
title = "Black Business Ownership by Peer City",
xaxis = list(title = "Percent of Residents who are Black"),
yaxis = list(title = "Percent of Businesses Owned by Black Residents",
range = c(0, 20)))
This graph shows the number of employer-businesses that Black residents own for every 100 Black residents.
ranking(business_ownership_county_clean,
"firms_num_per_100",
race = "black",
plot_title = "Black Business Ownership",
y_title = "Businesses per 100 residents",
year = 2017,
text_size = 2,
accuracy = 0.01,
FIPS_df = FIPS_df)
The map below shows business filings for the last week within Jefferson County. We are working with the Secretary of State’s Office to get a more complete listing and summarize this into data.
library(tidygeocoder)
library(leaflet)
test <- readxl::read_excel("business registration.xlsx")
lou_zips <- glptools::FIPS_zip %>%
filter(FIPS == "21111") %>%
pull(zip) %>%
as.numeric()
test %<>% filter(`Principal Office Zip` %in% lou_zips)
test %<>%
transmute(
Name,
street = `Principal Office Address 1`,
city = `Principal Office City`,
state = "KY",
postalcode = `Principal Office Zip`)
# Use free default providers first (Census and OSM)
test_cascade <- test %>%
geocode(
street = street,
city = city,
state = state,
postalcode = postalcode,
method = "cascade")
test_map <- st_as_sf(test_cascade,
coords = c("long", "lat"),
crs = 4326)
st_crs(jfco_sf) <- 4326
t=st_filter(test_map, jfco_sf)
leaflet(t) %>%
addTiles() %>%
addCircleMarkers(label = t$Name)
While housing is not the sole source of wealth, it represents a significant component. Housing reflects both historical wealth patterns––parental wealth makes it easier to buy a home––and is a major generator of wealth as, historically, homes have risen in value, increasing the wealth of those who own them.
The data show stark divides between Black and white families throughout the homeownership process, demonstrating one aspect of the wealth gap.
In 2019, about 3.8 mortgages were issued per 100 residents; however, the availability of mortgages varies greatly across the city. Two census tracts saw 0 mortgages issued in 2019, and most of West Louisville saw fewer than 1 mortgage issued per 100 residents. Meanwhile, many areas experienced a much larger availability of mortgages, especially where there is new construction around the edges of the county.
home_loan_tract_race <- home_loan_tract %>%
filter(year == 2019, sex == "total", race != "total") %>%
select(tract, race, denial:rate_spread)
home_loan_tract %<>%
filter(year == 2019, sex == "total", race == "total") %>%
select(tract, denial:rate_spread)
jfco_sf %<>% left_join(home_loan_tract, by = c("GEOID" = "tract"))
loan_num_labs <- c("No mortgages", "Less than 1", "1 to 3", "3 to 5", "5 to 10", "More than 10")
jfco_sf %<>%
mutate(
loan_num_fill =
case_when(
loan_number_per_100 == 0 ~ loan_num_labs[1],
loan_number_per_100 <= 1 ~ loan_num_labs[2],
loan_number_per_100 <= 3 ~ loan_num_labs[3],
loan_number_per_100 <= 5 ~ loan_num_labs[4],
loan_number_per_100 <= 10 ~ loan_num_labs[5],
loan_number_per_100 > 10 ~ loan_num_labs[6],
is.na(loan_number_per_100) ~ NA_character_,
TRUE ~ "error!!") %>%
factor(levels = loan_num_labs, ordered = TRUE))
ggplot(jfco_sf) +
geom_sf(aes(fill = loan_num_fill)) +
scale_fill_manual(values = viridis::viridis(6, direction = -1), na.value = "grey") +
theme_bw(base_size = 22, base_family = "Montserrat") +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank(),
legend.title = element_blank()) +
labs(title = "Mortgages issued per 100 residents in 2019") +
theme(
panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
legend.key = element_rect(fill = "transparent",colour = NA))
We can also examine mortgage data by race. Black residents in Louisville received fewer than half the number of mortgages per person that White residents did in 2019.
# Interactive Mortgage map
# load("home_loans_detail.RData")
# home_loan_detail %<>%
# select(tract, year, race, sex, loan_status, income, loan, rate) %>%
# mutate(tract = str_extract(tract, "21111.*")) %>%
# filter(year == 2019, loan_status == "approved")
#
# num_points <- home_loan_detail %>%
# group_by(tract) %>%
# summarise(n = n(), .groups="drop") %>%
# left_join(glptools::map_tract, by = "tract") %>%
# group_by(tract) %>%
# nest() %>%
# mutate(points = map(data, function(x) st_sample(x$geometry, x$n))) %>%
# unnest()
#
# home_loan_detail %<>% arrange(tract)
# num_points %<>% arrange(tract)
#
# st_geometry(home_loan_detail) <- num_points$points
#
# library(leaflet)
#
#
# fillpal <- colorFactor(RColorBrewer::brewer.pal(5, "Dark2"), domain = unique(home_loan_detail$race))
#
# leaflet(filter(home_loan_detail, is.na(race))) %>%
# addCircleMarkers(
# radius = ~sqrt(loan / 30000),
# #radius = 5,
# stroke=T,
# fillColor = ~fillpal(race),
# color = ~fillpal(race),
# weight = 1,
# fillOpacity = 0.15,
# opacity = 0.4) %>%
# addLegend(pal = fillpal, values = unique(home_loan_detail$race)) %>%
# addTiles()
mortgage_county <- home_loan_county
mortgage_county %<>% filter(FIPS == "21111", sex=="total", race %in% c("black", "white")) %>%
rename(Race = race) %>%
mutate(Race = str_to_title(Race))
plt_by(mortgage_county, Race, loan_number_per_100, "Mortgages by race", y_axis = "Mortgages per 100 People", y_min = 0)
The racial disparity is mortgages is even larger when you incorporate the dollar amount of mortgages issues. In 2019, white residents received $2.60 in mortgages for every $1 that Black residents received after adjusting for population size.
plt_by(mortgage_county, Race, loan_amount_pp, "Mortgage Lending by race", y_axis = "Dollars per 100 People", y_min = 0,
units = "Dollars")
Black residents are denied mortgages at a rate roughly twice that of white residents. The mortgage denial rate for Black residents has decreased from a high of 29% in 2008 to a low of 14% in 2019. However, it has not shown signs of decreasing in recent years, and Black residents are more likely to be impacted by the economic impacts of COVID-19, worsening the disparity in 2020 and beyond.
plt_by(mortgage_county, Race, denial, "Mortgage Denial by race", y_axis = "Denial Rate", y_min = 0, units= "Percent")
A major factor in mortgage availability is denial rates. While some areas of town saw few to no mortgage denials, people in many parts of West Louisville experienced denial rates of 30 to 40%.
make_map(denial, title = "Mortgage Denial Rate in 2019",
legend = "Percent",
caption = "Denial rate")
For the mortgages that were issued, interest rates varied from around 3.5% to around 5%. While the average interest rate was around 4% for the much of East Louisville, average interest rates in West Louisville were closer to 5%. A 30-year mortgage with an interest rate of 5% requires monthly payments that are 13% higher than a mortgage with an interest rate of 4%.
make_map(rate, title = "Mortgage Interest Rate in 2019",
legend = "Percent",
caption = "Interest rate")
As Louisville grows, increasing home prices reflect changes in inflation and increasing demand for homes. Long-term growth in home prices helps homeowners build equity and wealth. Short-term appreciation can be a boon to homeowners with the finances to stay in their home, though it also causes many homeowners and renters to be dislocated from their neighborhood.
This map shows the change in existing home prices across zip codes since 2000, controlling for new construction. Since 2000, existing homes in Louisville have increased in value by an average of 57% (an average of about 2.4% per year). However, not every area of the city has benefited equally from this growth. Home prices in zip code 40204, which contains the Upper Highlands and Germantown, have more than doubled since 2000. While many zip codes close to downtown also saw high growth, many parts of West Louisville saw slow growth, and homes in 40212 lost value.
lou_num <- HPI_county %>% filter(FIPS == "21111")
housing_price_index <- HPI_zip
housing_price_index %<>%
filter(year == 2019)
map_zip %<>% left_join(housing_price_index, by = "zip")
hpi_change <- c("Lost value", "0% - 25%", "25% - 50%", "50% - 75%", "75% - 100%", "100% - 125%")
hpi_2015_change <- c("Lost value", "0% - 10%", "10% - 20%", "20% - 30%", "30% - 40%", "40% - 50%")
map_zip %<>%
mutate(
hpi_fill =
case_when(
HPI < 100 ~ hpi_change[1],
HPI < 125 ~ hpi_change[2],
HPI < 150 ~ hpi_change[3],
HPI < 175 ~ hpi_change[4],
HPI < 200 ~ hpi_change[5],
HPI < 225 ~ hpi_change[6],
is.na(HPI) ~ NA_character_,
TRUE ~ "error!!") %>%
factor(levels = hpi_change, ordered = TRUE),
hpi_2015_fill =
case_when(
HPI_2015 < 0 ~ hpi_2015_change[1],
HPI_2015 < 10 ~ hpi_2015_change[2],
HPI_2015 < 20 ~ hpi_2015_change[3],
HPI_2015 < 30 ~ hpi_2015_change[4],
HPI_2015 < 40 ~ hpi_2015_change[5],
HPI_2015 < 50 ~ hpi_2015_change[6],
is.na(HPI) ~ NA_character_,
TRUE ~ "error!!") %>%
factor(levels = hpi_2015_change, ordered = TRUE))
ggplot(map_zip) +
geom_sf(aes(fill = hpi_fill)) +
scale_fill_manual(values = viridis::viridis(6, direction = -1), na.value = "grey") +
#scale_fill_viridis() +
theme_bw(base_size = 22, base_family = "Montserrat") +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank(),
legend.title = element_blank()) +
labs(title = "Change in housing prices since 2000") +
theme(
panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
legend.key = element_rect(fill = "transparent",colour = NA))
Looking at the growth since 2015 highlights zip codes where changes in home prices have been very acute. The average home in Louisville increased in value by 21% between 2015 and 2019. The vast majority of zip codes saw total growth of 10% - 30%, while changes in home prices for zip codes in West Louisville range from a decrease of 30% in 40212 to an increase of 40% in 40203. The rapid price increase in 40203, which contains parts of Russell and Old Louisville, threaten to displace many residents. In 40203, home prices across Louisville increased by an average of 8.8% per year.
ggplot(map_zip) +
geom_sf(aes(fill = hpi_2015_fill)) +
scale_fill_manual(values = viridis::viridis(6, direction = -1), na.value = "grey") +
#scale_fill_viridis() +
theme_bw(base_size = 22, base_family = "Montserrat") +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank(),
legend.title = element_blank()) +
labs(title = "Change in housing prices since 2015") +
theme(
panel.background = element_rect(fill = "transparent", color = NA), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
legend.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend bg
legend.box.background = element_rect(fill = "transparent", color = "transparent"), # get rid of legend panel bg
legend.key = element_rect(fill = "transparent",colour = NA))
On average, owner-occupied homes in Black neighborhoods are undervalued by $48,000 per house in the U.S. According to that same reserach by the Brookings Institute The median home value in majority Black neighborhoods is $89,681, but would be $117,593 if houses were not devalued in the Louisville Metro Area. This difference consistutes a 27% undervaluation from what home values in Black neighborhoods would be if based on structural characteristics (e.g. sq. ft, year built) and neighborhood amenities (e.g. walkability, school districts, commute time).
While facing lower home values on the market, Black homes are overvalued by the property tax administration, and thus face higher taxation relative to the market value of their homes.
See map of effective tax rates here, to be incorporated into report.
We have the most data on housing - but this is not the only area of wealth building where this same pattern plays out. Black families both start with less wealth (and therefore less opportunities to build on it even in a ‘fair’ market) and face discrimination at each step of the process.
Slightly more than 1 in 3 Black Louisville residents own their own homes. While this is roughly toward the middle of our peer cities, it is roughly half the homeownership rate among white residents. Since 2010, Louisville’s racial homeownership gap has been among the largest of our peer cities.
housing_df <- housing_county %>%
filter(var_type == "percent")
housing_df_gap <- housing_df %>%
filter(sex == "total", race %in% c("black", "white"), var_type == "percent") %>%
select(FIPS, year, race, homeownership) %>%
pivot_wider(values_from = homeownership, names_from = race) %>%
mutate(gap = white - black)
ranking(housing_df,
homeownership,
race = "black",
year = 2019,
text_size = 2,
FIPS_df = FIPS_df,
plot_title = "Black Homeownership",
caption = "Source: Greater Louisville Project
GLP analysis of ACS microdata from IPUMS USA")
Homeownership among all Louisville residents, including Black residents, has declined slightly since the early 2000s.
housing_df_clean <- housing_df %>%
filter(FIPS == "21111", sex == "total", race %not_in% c("other", "hispanic")) %>%
mutate(race = str_to_title(race))
plt_by(housing_df_clean,
race,
homeownership,
title_text = "Homeownership by Race",
caption_text = "Source: Greater Louisville Project
GLP analysis of ACS microdata from IPUMS USA")
Across Louisville, homeownership varies from less than 10% in some areas to the high 90s in others.
housing_map_clean <- housing_tract %>%
filter(sex == "total", race == "total", year == 2017, var_type == "percent") %>%
select(-sex, -race, -year, -var_type)
jfco_sf %<>%
left_join(housing_map_clean, by = c("GEOID" = "tract"))
make_map(homeownership,
"Homeownership",
legend = "Percent",
caption = "Source: Greater Louisville Project
ACS table B25106")
Many activities that lead to wealth-creation, like starting a business or getting a degree, are not directly tied to income. However, the majority of families build wealth by saving the money they earn. Disparities in income lead to larger disparities in wealth.
While income for Black Households in Louisville has trended up over the last few years, the median Black household only receives about two-thirds the income of the median Louisville household. Additionally, after adjusting for inflation, median income declined among Black households from 2000 to 2013 and only surpriassed their previous levels in 2017.
hh_income_filtered <- hh_income_county %>%
filter(var_type == "estimate",
race %in% c("black", "total", "white", "hispanic"),
FIPS == "21111") %>%
mutate(race = str_to_title(race))
plt_by(hh_income_filtered,
race,
hh_income,
y_axis = "Dollars",
units = "Dollars",
title_text = "Household Income by Race",
subtitle_text = "Adjusted for inflation to 2019 dollars",
caption_text = "Source: Greater Louisville Project
ACS Tables P053, P152, B19013")
The median household income varies widely across Louisville, ranging from under $20,000 in some areas to over $150,000 in others.
hh_income_tract_clean <- hh_income_tract %>%
filter(year == 2016,
race %in% c("total", "black")) %>%
pivot_wider(names_from = race, values_from = hh_income, names_prefix = "hh_income_") %>%
select(-year, -sex)
jfco_sf %<>%
left_join(hh_income_tract_clean, by = c("GEOID" = "tract")) %>%
mutate(hh_income_black = if_else(hh_income_black < -1000000, NA_real_, hh_income_black))
make_map(hh_income_total,
"Median Household income",
legend = "Dollars",
caption = "Source: Greater Louisville Project
ACS Table B19013")
We have the most data on housing, but this is not the only area of wealth building where systemic inequality is pervasive. Black families start with less wealth (and therefore have less opportunities to build on it even in an ‘equal’ market) and face discrimination at each step of the process. A better understanding of what metrics are important for describing Black wealth in both quantitative and qualitative terms is important to improve our work in this area.